Grafik als screenshot

[bitsetter]

Hallo,

Zitat von Hartfrid Krause:

Außerdem:
ih würde gerne den label1.caption dann jeweils an der Mausspitze haben, um den Ländernamen quasi "auf" dem Land zu haben, wenn ich drüberfahre

Wie das geht, weiss ich nicht


wer hilft??

dazu ist mir was eingefallen, man kann einen Cursor für Paintbox2 erstellen, der den Namen der Bundesländer dann anzeigt.

Delphi-Quellcode:

  
  private
    Bitmap2: TBitmap;//Bild im Speicher
    NewCursor: TIcon;//selbst erstellter Cursor
    CursorText: AnsiString;//Text des Cursors
  public
    { Public declarations }
  end;

//...

procedure TForm1.FormShow(Sender: TObject);
begin     
  NewCursor:= TIcon.Create;//Cursor mit Text
  CursorText:= ' ';

  Bitmap2 := TBitmap.Create;
  Bitmap2.LoadFromFile('bildbundeslaender.bmp');//Bild mit schon eingefärbten Bundesländern
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  NewCursor.Free;
  Bitmap2.Free;
end;

//einen Cursor mit Text erstellen und zuweisen
procedure SetTextCursor(Text: AnsiString; var NewCursor: TIcon; Contr: TControl);
var
  ImageList: TImageList;
  BildTemp: TBitmap;
const
  FadenKreuzWidth = 10;
begin
  BildTemp := TBitmap.Create;
  try
    if Win32Platform = VER_PLATFORM_WIN32_NT then
    begin
      BildTemp.Width := BildTemp.Canvas.TextWidth(Text);
      if BildTemp.width < FadenKreuzWidth then
        BildTemp.width := FadenKreuzWidth+ 1;
      BildTemp.Height := 38;
    end;
    if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
    begin
      BildTemp.width := 32;
      BildTemp.Height := 32;
    end;
    BildTemp.Canvas.Brush.Color:= clWhite- 10;
    if Assigned(NewCursor) then
      NewCursor.Free;
    NewCursor:= TIcon.Create;
    NewCursor.Width := BildTemp.Width;
    NewCursor.Height := BildTemp.Height;
    ImageList:= TImageList.CreateSize(BildTemp.width, BildTemp.height);
    try
      if Text <> '' then
        BildTemp.Canvas.TextOut(0, 0, Text);
      BildTemp.Canvas.MoveTo(BildTemp.Width div 2- FadenKreuzWidth div 2, 19);
      BildTemp.Canvas.LineTo(BildTemp.Width div 2+ (FadenKreuzWidth div 2)+ 1, 19);
      BildTemp.Canvas.MoveTo(BildTemp.Width div 2, 14);
      BildTemp.Canvas.LineTo(BildTemp.Width div 2, 25);

      ImageList.AddMasked(BildTemp, clWhite);
      ImageList.GetIcon(0, NewCursor);

      Screen.Cursors[0] := NewCursor.Handle;
      Contr.Cursor := 1;
    finally
      ImageList.Free;
    end;
  finally
    BildTemp.Free;
  end;  
end;

procedure TForm1.paintbox2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer); 
var
  NewText: AnsiString;
begin
  NewText := '';
  if (X <= Bitmap2.Width) and (Y <= Bitmap2.Height) then
    case Bitmap2.canvas.pixels[X, Y] of//Pixel vom Bild im Speicher auslesen
     clcream:label1.Caption:='Nordrhein-Westfalen';
     $0005727A:label1.Caption:='Rheinland-Pfalz';
     $006F6F11:label1.Caption:='Niedersachsen';
     $00C551D9:label1.Caption:='Hessen';
     ... 
    end;

  if NewText <> CursorText then
  begin
    CursorText := NewText;               //Control mit geändertem Cursor
    SetTextCursor(CursorText, NewCursor, PaintBox2);//einen Cursor mit Text erstellen
  end;
    end;
end;

[Hartfrid Krause]

Klasse, es klappt
Dank an bitsetter

[bitsetter]

Hallo,

schön dass es jetzt endlich klappt

Funktioniert das mit dem Cursor auch, denn ich habe noch einen kleinen Fehler entdeckt:

Delphi-Quellcode:

procedure TForm1.paintbox2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
  NewText: AnsiString;
begin
  NewText := '';
  if (X <= Bitmap2.Width) and (Y <= Bitmap2.Height) then
    case Bitmap2.canvas.pixels[X, Y] of
     //anstatt label1.Caption muss hier natürlich immer "NewText:=" stehen
     clcream:NewText:='Nordrhein-Westfalen';
     $0005727A:NewText:='Rheinland-Pfalz';
     $006F6F11:NewText:='Niedersachsen';
     $00C551D9:NewText:='Hessen';
     ...
    end;

  if NewText <> CursorText then
  begin
    CursorText := NewText;               //Control mit geändertem Cursor
    SetTextCursor(CursorText, NewCursor, PaintBox2);//einen Cursor mit Text erstellen
  end;
    end;
end;