Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   FreePascal (https://www.delphipraxis.net/74-freepascal/)
-   -   DelphiCode für Lazarus (https://www.delphipraxis.net/145438-delphicode-fuer-lazarus.html)

MiniMax 1. Jan 2010 13:04


DelphiCode für Lazarus
 
Liste der Anhänge anzeigen (Anzahl: 1)
Hallo Zusammen,
erstmal wünsche ich euch ein Frohes Neues Jahr! :cheers:
Ich habe ein Problem:
Hier im Forum habe ich von einem sehr sehr nettem Mitglied ein Delphi Code bekommen! Leider funktioniert dieser net unter Lazarus! :cry: ! Dann kahm mir die Idee mit dem Umwandel Tool von Lazarus, aber das Klappte auch net! :coder2:
So bitte ich euch jetzt ob mir Jemand sagen kann wie ich den Code unter Lazarus zum Laufen bekomme!
Vielen Dank im Voraus

SirThornberry 1. Jan 2010 13:12

Re: DelphiCode für Lazarus
 
Warum verrätst du uns nicht einfach welcher Fehler an welcher Stelle kommt? :)

thkerkmann 1. Jan 2010 13:12

Re: DelphiCode für Lazarus
 
Gibt es Fehlermeldungen ?

Wo ist die .dfm Datei ?

Sollen wir raten ?

:glaskugel:

MiniMax 1. Jan 2010 13:16

Re: DelphiCode für Lazarus
 
Hallo, ich habe nur diese Datei bekommen!

Die Fehlermeldungen wenn ich es nur so Komplimiere - ohne Form!

Delphi-Quellcode:
windres: can't open file `project1.manifest': No such file or directory
Hint: Start of reading config file c:\lazarus\fpc\2.2.4\bin\i386-win32\fpc.cfg
Hint: End of reading config file c:\lazarus\fpc\2.2.4\bin\i386-win32\fpc.cfg
Free Pascal Compiler version 2.2.4 [2009/10/25] for i386
Copyright (c) 1993-2008 by Florian Klaempfl
Target OS: Win32 for i386
Compiling C:\DOKUME~1\MiniMax\LOKALE~1\Temp\project1.lpr
Compiling resource C:\DOKUME~1\MiniMax\LOKALE~1\Temp\project1.rc
c:\lazarus\fpc\2.2.4\bin\i386-win32\windres.exe: can't open file `project1.manifest': No such file or directory
project1.lpr(19,1) Error: Error while linking
project1.lpr(19,1) Fatal: There were 1 errors compiling module, stopping
Und wenn ich es in ein Projeck Reinkopiere, kommen keine Fehlermeldungen aber ich sehe auch nichts
Warnungen:

Delphi-Quellcode:
unit1.pas(95,16) Warning: unreachable code
unit1.pas(98,16) Warning: unreachable code
unit1.pas(113,44) Warning: unreachable code
unit1.pas(128,44) Warning: unreachable code
unit1.pas(10,20) Hint: Unit "messages" not used in Unit1
unit1.pas(11,30) Hint: Unit "StdCtrls" not used in Unit1
Projekt "project1" erfolgreich gebaut. :)
und das Ist der Code:

Delphi-Quellcode:
unit Unit1;

{$mode objfpc}{$H+}

interface



uses
  LCLIntf, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

const
  cMaxValue    = 100;
  cLengthNeedle = 120;
  cAngle       = 1.75*pi; // = (cAngle / pi) * 180 GRAD
  cStartAngle  = 1.15*pi; // = (cStartAngle / pi) * 180 GRAD
  cAntialiased = true;    // Weichzeichnung
  cStartPosX   = -1;      // -1 --> mittig
  cStartPosY   = -1;      // -1 --> mittig

type

  { TfrmMain }

  TfrmMain = class(TForm)
    pbVUMeter: TPaintBox;
    Timer: TTimer;
    procedure pbVUMeterPaint(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private-Deklarationen }
    FValue         : integer;
    //
    BackgroundImage : TBitmap;
    //
    procedure SetValue(const Value: integer);
  public
    { Public-Deklarationen }
    property Value : integer read FValue write SetValue;
  end;

var
  frmMain: TfrmMain;

implementation


procedure TfrmMain.FormCreate(Sender: TObject);
var P : TFileName;
begin
     //--
     Self.DoubleBuffered := true; // damit es nicht so flackert
     //
     BackgroundImage := TBitmap.Create;
     //
     p := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName)) + 'hintergrund.bmp';
     //
     if FileExists(p) then BackgroundImage.LoadFromFile(p)
     else MessageDLG('Bild-Datei "hintergrund.bmp" im Programm-Ordner nicht gefunden!',mtError,[mbOK],0);
     //
     Value := 0;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
     //--
     BackgroundImage.Free;
end;

procedure TfrmMain.pbVUMeterPaint(Sender: TObject);
var eX,eY  : integer;
var sX,sY  : integer;
var d      : real;
var pS,pE  : TPoint;
var i      : integer;
var f      : integer;
begin
     //--
     with pbVUMeter.Canvas do
     begin
          Brush.Color := clWhite;
          Brush.Style := bsSolid;
          //
          Pen.Style  := psSolid;
          //
          FillRect(pbVUMeter.ClientRect);
          //
          // HINTERGRUND-BILD MALEN
          Draw(0,0,BackgroundImage);
          //
          if cStartPosX = -1 then sX := pbVUMeter.Width div 2
          else sX := cStartPosX;
          //
          if cStartPosY = -1 then sY := pbVUMeter.Height div 2
          else sY := cStartPosY;
          //
          //
          d := cStartAngle - (FValue/cMaxValue)*(cAngle);
          //
          eX := sX + Round(cos(d)*(cLengthNeedle));
          //
          eY := sY - Round(sin(d)*(cLengthNeedle));
          //
          pS.X := sX + Round(cos(cStartAngle - cAngle)*(cLengthNeedle));
          pS.Y := sY - Round(sin(cStartAngle - cAngle)*(cLengthNeedle));
          //
          pE.X := sX + Round(cos(cStartAngle)*(cLengthNeedle));
          pE.Y := sY - Round(sin(cStartAngle)*(cLengthNeedle));
          //
          if cAntialiased then f := 2 else f := 1;
          //
          for i := f downto 1 do
          begin
              if i = 2 then Pen.Color := RGB(168,168,168)
              else Pen.Color := clBlack;
              //
              Pen.Width  := i;
              //
              Arc(sx - cLengthNeedle,sy - cLengthNeedle,sx + cLengthNeedle, sy + cLengthNeedle,ps.X,ps.Y,pe.X,pe.Y);
              MoveTo(pS.x,pS.Y);
              LineTo(sx,sy);
              LineTo(pE.X,pE.Y);
          end;
          //
          if cAntialiased then f := 3 else f := 2;
          //
          for i := f downto 2 do
          begin
              if i = 3 then Pen.Color := RGB(168,168,168)
              else Pen.Color := clRed;
              //
              Pen.Width := i;
              //
              MoveTo(sX,sY);
              LineTo(eX,eY);
          end;
     end;
end;

procedure TfrmMain.SetValue(const Value: integer);
begin
     //--
     FValue := Value;
     //
     pbVUMeter.Repaint;
end;

procedure TfrmMain.TimerTimer(Sender: TObject);
begin
     //--
     Value := (Value + 2) mod cMaxValue;
end;

end.
    property Value : integer read FValue write SetValue;
  end;

var
  frmMain: TfrmMain;

implementation


procedure TfrmMain.FormCreate(Sender: TObject);
var P : TFileName;
begin
     //--
     Self.DoubleBuffered := true; // damit es nicht so flackert
     //
     BackgroundImage := TBitmap.Create;
     //
     p := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName)) + 'hintergrund.bmp';
     //
     if FileExists(p) then BackgroundImage.LoadFromFile(p)
     else MessageDLG('Bild-Datei "hintergrund.bmp" im Programm-Ordner nicht gefunden!',mtError,[mbOK],0);
     //
     Value := 0;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
     //--
     BackgroundImage.Free;
end;

procedure TfrmMain.pbVUMeterPaint(Sender: TObject);
var eX,eY  : integer;
var sX,sY  : integer;
var d      : real;
var pS,pE  : TPoint;
var i      : integer;
var f      : integer;
begin
     //--
     with pbVUMeter.Canvas do
     begin
          Brush.Color := clWhite;
          Brush.Style := bsSolid;
          //
          Pen.Style  := psSolid;
          //
          FillRect(pbVUMeter.ClientRect);
          //
          // HINTERGRUND-BILD MALEN
          Draw(0,0,BackgroundImage);
          //
          if cStartPosX = -1 then sX := pbVUMeter.Width div 2
          else sX := cStartPosX;
          //
          if cStartPosY = -1 then sY := pbVUMeter.Height div 2
          else sY := cStartPosY;
          //
          //
          d := cStartAngle - (FValue/cMaxValue)*(cAngle);
          //
          eX := sX + Round(cos(d)*(cLengthNeedle));
          //
          eY := sY - Round(sin(d)*(cLengthNeedle));
          //
          pS.X := sX + Round(cos(cStartAngle - cAngle)*(cLengthNeedle));
          pS.Y := sY - Round(sin(cStartAngle - cAngle)*(cLengthNeedle));
          //
          pE.X := sX + Round(cos(cStartAngle)*(cLengthNeedle));
          pE.Y := sY - Round(sin(cStartAngle)*(cLengthNeedle));
          //
          if cAntialiased then f := 2 else f := 1;
          //
          for i := f downto 1 do
          begin
              if i = 2 then Pen.Color := RGB(168,168,168)
              else Pen.Color := clBlack;
              //
              Pen.Width  := i;
              //
              Arc(sx - cLengthNeedle,sy - cLengthNeedle,sx + cLengthNeedle, sy + cLengthNeedle,ps.X,ps.Y,pe.X,pe.Y);
              MoveTo(pS.x,pS.Y);
              LineTo(sx,sy);
              LineTo(pE.X,pE.Y);
          end;
          //
          if cAntialiased then f := 3 else f := 2;
          //
          for i := f downto 2 do
          begin
              if i = 3 then Pen.Color := RGB(168,168,168)
              else Pen.Color := clRed;
              //
              Pen.Width := i;
              //
              MoveTo(sX,sY);
              LineTo(eX,eY);
          end;
     end;
end;

procedure TfrmMain.SetValue(const Value: integer);
begin
     //--
     FValue := Value;
     //
     pbVUMeter.Repaint;
end;

procedure TfrmMain.TimerTimer(Sender: TObject);
begin
     //--
     Value := (Value + 2) mod cMaxValue;
end;

end.

MiniMax 1. Jan 2010 13:45

Re: DelphiCode für Lazarus
 
Hallo Zusammen,
ich habe es Hinbekommen! Fragt mich nicht wie --> ich weis es selber net :gruebel:
Ich danke euch für eure Mühe! Und wünsche euch noch ein schönen Neujahres Tag :thumb:

JamesTKirk 1. Jan 2010 14:22

Re: DelphiCode für Lazarus
 
Ich vermute mal, dass die Lösung war das Projekt irgendwo zu speichern.

Dieses Problem war die letzten Tage auch mal auf der FPC Mailing List (und zwar dieser Thread). Die Ursache ist, dass die Manifestdatei nicht im temporären Verzeichnis mit angelegt wird (Bug). Unter Linux hättest du diesen Fehler nicht bemerkt, da es dort kein Manifest gibt ;)

Gruß und ein frohes neues Jahr,
Sven


Alle Zeitangaben in WEZ +1. Es ist jetzt 03:19 Uhr.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz